home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / netmail / rnr214.zip / PRINTMSG.PAS < prev    next >
Pascal/Delphi Source File  |  1996-03-01  |  11KB  |  468 lines
  1. program printmsg;
  2.  
  3. {
  4. Russell_Schulz@locutus.ofB.ORG (960202)
  5.  
  6. Copyright 1996 Russell Schulz
  7.  
  8. this code is not in the Public Domain
  9.  
  10. permission is granted to use these routines in any application regardless
  11. of commercial status as long as the author of these routines assumes no
  12. liability for any damages whatsoever for any reason.  have fun.
  13. }
  14.  
  15. uses dos,genericf,rdheader;
  16.  
  17. const
  18. {
  19.   languagelist='ps,pcl';
  20. }
  21.   languagelist='ps';
  22.   defaultlanguage='ps';
  23.   defaultoutputfn='lpt1';
  24.  
  25. var
  26.   firstfnparam: integer;
  27.   outputfn: string;
  28.   language: string;
  29.   maxlines: longint;
  30.  
  31. procedure usage;
  32.  
  33. begin
  34.   writeln('printmsg -- print message');
  35.   writeln;
  36.   writeln('usage:');
  37.   writeln('  printmsg [optional-parameters] file [file ...]');
  38.   writeln;
  39.   writeln('options:');
  40.   writeln('  -o file     send output to filename, default ',defaultoutputfn);
  41.   writeln('  -l language select printer language from "',languagelist,
  42.    '", default: ',defaultlanguage);
  43.   writeln('  -m lines    specify maxinum number of lines to print');
  44.   writeln;
  45.   writeln('Russell_Schulz@locutus.ofB.ORG (960202)');
  46.   halt(1);
  47. end;
  48.  
  49. procedure msgusage(s: string);
  50.  
  51. begin
  52.   writeln(s);
  53.   usage;
  54. end;
  55.  
  56. procedure initialize;
  57.  
  58. var
  59.   currparami: integer;
  60.   currparams: string;
  61.   nextparams: string;
  62.  
  63. begin
  64.   outputfn := defaultoutputfn;
  65.   language := defaultlanguage;
  66.   maxlines := 0;
  67.  
  68.   if paramcount<1 then
  69.     usage;
  70.  
  71.   firstfnparam := 1;
  72.   currparami := 1;
  73.   while currparami<=paramcount do
  74.     begin
  75.       currparams := paramstr(currparami);
  76.       if currparami<paramcount then
  77.         nextparams := paramstr(currparami+1)
  78.       else
  79.         nextparams := '';
  80.  
  81.       if currparams='-?' then
  82.         usage
  83.       else if currparams='-o' then
  84.         begin
  85.           if nextparams='' then
  86.             msgusage('-o requires a filename');
  87.           outputfn := nextparams;
  88.           inc(currparami);
  89.         end
  90.       else if currparams='-l' then
  91.         begin
  92.           if nextparams='' then
  93.             msgusage('-l requires a language');
  94.           language := nextparams;
  95.           inc(currparami);
  96.           if pos(','+language+',',','+languagelist+',')=0 then
  97.             msgusage('language '+language+' not recognized');
  98.         end
  99.       else if currparams='-m' then
  100.         begin
  101.           if nextparams='' then
  102.             msgusage('-m requires an integer');
  103.           maxlines := atol(nextparams);
  104.           inc(currparami);
  105.         end
  106.       else if currparams='--' then
  107.         begin
  108.           firstfnparam := currparami+1;
  109.           currparami := paramcount;
  110.         end
  111.       else if copy(currparams,1,1)<>'-' then
  112.         begin
  113.           firstfnparam := currparami;
  114.           currparami := paramcount;
  115.         end
  116.       else
  117.         msgusage('unknown parameter: '+currparams);
  118.  
  119.       inc(currparami);
  120.     end;
  121.  
  122.   if paramcount<firstfnparam then
  123.     msgusage('at least one filename must be specified');;
  124. end;
  125.  
  126. function newline(oneline: string): string;
  127.  
  128. var
  129.   result: string;
  130.   chari: integer;
  131.   charc: char;
  132.  
  133. begin
  134.   result := '';
  135.  
  136.   result := result+'(';
  137.  
  138.   for chari := 1 to length(oneline) do
  139.     begin
  140.       charc := oneline[chari];
  141.       if (charc='(') or (charc=')') or (charc='\') then
  142.         result := result+'\';
  143.       result := result+charc;
  144.     end;
  145.  
  146.   result := result+')';
  147.  
  148.   newline := result;
  149. end;
  150.  
  151. procedure outputline(var outputf: text; oneline: string);
  152.  
  153. const
  154.   minlength=20;
  155.   maxlength=90;
  156.  
  157. var
  158.   mangledline: string;
  159.   partoftheline: string;
  160.   breakpoint: integer;
  161.   possiblebreakpoint: integer;
  162.   indent: string;
  163.  
  164. begin
  165.   mangledline := oneline;
  166.  
  167. {want to do this at least once, even if oneline is empty}
  168.   repeat
  169.     partoftheline := mangledline;
  170.  
  171.     if length(partoftheline)<=maxlength then
  172.       mangledline := ''
  173.     else
  174.       begin
  175.         indent := '';
  176.  
  177. {break on the last possible word.  this leaves a trailing space (which is ok)}
  178.         breakpoint := 0;
  179.         for possiblebreakpoint := minlength to maxlength do
  180.           if partoftheline[possiblebreakpoint]=' ' then
  181.             begin
  182.               breakpoint := possiblebreakpoint;
  183.               indent := '        ';
  184.             end;
  185.  
  186. {handle long Path: headers}
  187.         if breakpoint=0 then
  188.           begin
  189.             for possiblebreakpoint := minlength to maxlength do
  190.               if partoftheline[possiblebreakpoint]='!' then
  191.                 begin
  192.                   breakpoint := possiblebreakpoint;
  193.                   indent := '        ';
  194.                 end;
  195.           end;
  196.  
  197. {handle long Newsgroups: headers}
  198.         if breakpoint=0 then
  199.           begin
  200.             for possiblebreakpoint := minlength to maxlength do
  201.               if partoftheline[possiblebreakpoint]=',' then
  202.                 begin
  203.                   breakpoint := possiblebreakpoint;
  204.                   indent := '        ';
  205.                 end;
  206.           end;
  207.  
  208. {look for anything!}
  209.         if breakpoint=0 then
  210.           begin
  211.             for possiblebreakpoint := minlength to maxlength do
  212.               if not isalpha(partoftheline[possiblebreakpoint]) then
  213.                 begin
  214.                   breakpoint := possiblebreakpoint;
  215.                   indent := '        ';
  216.                 end;
  217.           end;
  218.  
  219. {nowhere nice to break.  oh well.  just break it so we can see it}
  220.         if breakpoint=0 then
  221.           breakpoint := maxlength;
  222.  
  223.         partoftheline := copy(partoftheline,1,breakpoint);
  224.         mangledline := indent+copy(mangledline,breakpoint+1,255);
  225.       end;
  226.  
  227.     writeln(outputf,newline(partoftheline),' n');
  228.   until mangledline='';
  229. end;
  230.  
  231. procedure printheader(left,middle,right: string);
  232.  
  233. begin
  234. end;
  235.  
  236. procedure printfooter(left,middle,right: string);
  237.  
  238. begin
  239. end;
  240.  
  241. procedure printonemsg(var outputf: text; inputfn: string);
  242.  
  243. const
  244.   switchtofontlength=20;
  245.  
  246. type
  247.   fontt=(plain, bold, italics);
  248.  
  249. var
  250.   inputf: text;
  251.  
  252.   inheaders: boolean;
  253.   numlines: longint;
  254.   oneline: string;
  255.  
  256.   headername: string;
  257.  
  258.   headerfrom: string;
  259.   headerdate: string;
  260.   headersubject: string;
  261.  
  262.   currentfont: fontt;
  263.   newfont: fontt;
  264.   switchtofont: array[fontt] of string[switchtofontlength];
  265.  
  266. begin
  267.   switchtofont[plain] := 'plain';
  268.   switchtofont[bold] := 'bold';
  269.   switchtofont[italics] := 'italics';
  270.  
  271. {need to do this now to avoid problems with SHARE}
  272.   headerfrom := getheaderline(inputfn,'from:');
  273.   headerdate := getheaderline(inputfn,'date:');
  274.   headersubject := getheaderline(inputfn,'subject:');
  275.  
  276.   assign(inputf,inputfn);
  277. {$I-}
  278.   reset(inputf);
  279. {$I+}
  280.   if ioresult<>0 then
  281.     msgusage('could not read '+inputfn);
  282.  
  283.   writeln(outputf,'% begin ',inputfn);
  284.   writeln(outputf);
  285.   writeln(outputf,'/pageno 0 def');
  286.   writeln(outputf);
  287.  
  288.   writeln(outputf,'/headerfrom ',newline(headerfrom),' def');
  289.   writeln(outputf,'/headerdate ',newline(headerdate),' def');
  290.   writeln(outputf,'/headersubject ',newline(headersubject),' def');
  291.   writeln(outputf);
  292.  
  293.   writeln(outputf,'startpage');
  294.   writeln(outputf);
  295.  
  296.   currentfont := plain;
  297.  
  298.   inheaders := true;
  299.   numlines := 0;
  300.   while ((maxlines=0) or (numlines<=maxlines)) and not eof(inputf) do
  301.     begin
  302.       inc(numlines);
  303.       read(inputf,oneline);
  304.       if eoln(inputf) then
  305.         readln(inputf);
  306.  
  307.       if oneline='' then
  308.         inheaders := false;
  309.  
  310.       newfont := plain;
  311.  
  312.       if inheaders then
  313.         begin
  314. {}{}{}{} {handle hiding}
  315.           headername := lower(getfirstw(oneline));
  316.  
  317.           if headername='date:' then
  318.             newfont := bold;
  319.           if headername='from:' then
  320.             newfont := bold;
  321.           if headername='to:' then
  322.             newfont := bold;
  323.           if headername='subject:' then
  324.             newfont := bold;
  325.  
  326.           if currentfont<>newfont then
  327.             writeln(outputf,switchtofont[newfont]);
  328.  
  329.           outputline(outputf,oneline);
  330.         end
  331.       else
  332.         begin
  333. {}{}{}{} {handle paragraph breaks, quoting}
  334.           if copy(oneline,1,1)='>' then
  335.             newfont := italics;
  336.  
  337.           if currentfont<>newfont then
  338.             writeln(outputf,switchtofont[newfont]);
  339.  
  340.           outputline(outputf,oneline);
  341.         end;
  342.  
  343.       currentfont := newfont;
  344.     end;
  345.  
  346.   writeln(outputf,'showpage');
  347.   writeln(outputf);
  348.   writeln(outputf,'% end ',inputfn);
  349.   writeln(outputf);
  350.  
  351.   close(inputf);
  352. end;
  353.  
  354. procedure printprelude(var outputf: text);
  355.  
  356. begin
  357.   writeln(outputf,'%! PS');
  358.   writeln(outputf);
  359.   writeln(outputf,'/bigbold');
  360.   writeln(outputf,'{');
  361.   writeln(outputf,'  /Courier-Bold findfont 16 scalefont setfont');
  362.   writeln(outputf,'} def');
  363.   writeln(outputf);
  364.   writeln(outputf,'/bold');
  365.   writeln(outputf,'{');
  366.   writeln(outputf,'  /Courier-Bold findfont 10 scalefont setfont');
  367.   writeln(outputf,'  /vertdiff 12 def');
  368.   writeln(outputf,'} def');
  369.   writeln(outputf);
  370.   writeln(outputf,'/italics');
  371.   writeln(outputf,'{');
  372.   writeln(outputf,'  /Courier-Oblique findfont 8 scalefont setfont');
  373.   writeln(outputf,'  /vertdiff 10 def');
  374.   writeln(outputf,'} def');
  375.   writeln(outputf);
  376.   writeln(outputf,'/plain');
  377.   writeln(outputf,'{');
  378.   writeln(outputf,'  /Courier findfont 10 scalefont setfont');
  379.   writeln(outputf,'  /vertdiff 12 def');
  380.   writeln(outputf,'} def');
  381.   writeln(outputf);
  382.   writeln(outputf,'/header');
  383.   writeln(outputf,'{');
  384.   writeln(outputf,'  20 750 moveto headerfrom show');
  385.   writeln(outputf,'} def');
  386.   writeln(outputf);
  387.   writeln(outputf,'/footer');
  388.   writeln(outputf,'{');
  389.   writeln(outputf,'  20 50 moveto headerdate show');
  390.   writeln(outputf,'  500 50 moveto (Page ) show pageno pagenostr cvs show');
  391.   writeln(outputf,'} def');
  392.   writeln(outputf);
  393.   writeln(outputf,'/startpage');
  394.   writeln(outputf,'{');
  395.   writeln(outputf,'  /vert 720 def');
  396.   writeln(outputf,'  /pageno pageno 1 add def');
  397.   writeln(outputf,'  bigbold');
  398.   writeln(outputf,'  header');
  399.   writeln(outputf,'  footer');
  400.   writeln(outputf,'  plain');
  401.   writeln(outputf,'} def');
  402.   writeln(outputf);
  403.   writeln(outputf,'/newpage');
  404.   writeln(outputf,'{');
  405.   writeln(outputf,'  showpage');
  406.   writeln(outputf,'  startpage');
  407.   writeln(outputf,'} def');
  408.   writeln(outputf);
  409.   writeln(outputf,'/n');
  410.   writeln(outputf,'{');
  411.   writeln(outputf,'% check here if vert is <100, and if so start a new page');
  412.   writeln(outputf,'  vert 100 lt {newpage} if');
  413.   writeln(outputf,'  20 vert moveto');
  414.   writeln(outputf,'  show');
  415.   writeln(outputf,'  /vert vert vertdiff sub def');
  416.   writeln(outputf,'} def');
  417.   writeln(outputf);
  418.   writeln(outputf,'/pagenostr 20 string def');
  419.   writeln(outputf);
  420. end;
  421.  
  422. procedure printpostlude(var outputf: text);
  423.  
  424. begin
  425.   writeln(outputf,'% done');
  426. end;
  427.  
  428. procedure process;
  429.  
  430. var
  431.   outputf: text;
  432.  
  433.   eachparam: integer;
  434.   inputfn: string;
  435.   fileinfo: searchrec;
  436.  
  437. begin
  438.   assign(outputf,outputfn);
  439. {$I-}
  440.   rewrite(outputf);
  441. {$I+}
  442.   if ioresult<>0 then
  443.     msgusage('could not write to '+outputfn);
  444.  
  445.   printprelude(outputf);
  446.  
  447.   for eachparam := firstfnparam to paramcount do
  448.     begin
  449.       inputfn := unslash(paramstr(eachparam));
  450. {}{}{}{} {handle wildcards}
  451.       printonemsg(outputf,inputfn);
  452.     end;
  453.  
  454.   printpostlude(outputf);
  455.   close(outputf);
  456. end;
  457.  
  458. procedure shutdown;
  459.  
  460. begin
  461. end;
  462.  
  463. begin {main}
  464.   initialize;
  465.   process;
  466.   shutdown;
  467. end.
  468.